home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / feel0_89.lha / Feel / Src / semaphores.c < prev    next >
C/C++ Source or Header  |  1993-06-30  |  5KB  |  229 lines
  1. /* ******************************************************************** */
  2. /* semaphores.c      Copyright (C) Codemist and University of Bath 1989 */
  3. /*                                                                      */
  4. /* Lisp semaphores                                               */
  5. /* ******************************************************************** */
  6.  
  7. /*
  8.  * $Id: semaphores.c,v 1.8 1992/06/09 14:05:48 pab Exp $
  9.  *
  10.  * $Log: semaphores.c,v $
  11.  * Revision 1.8  1992/06/09  14:05:48  pab
  12.  * fixed includes
  13.  *
  14.  * Revision 1.7  1992/05/28  11:27:36  pab
  15.  * changed value vector (unused)
  16.  *
  17.  * Revision 1.6  1992/05/19  11:26:08  pab
  18.  * fixed to be strings
  19.  *
  20.  * Revision 1.5  1992/01/29  13:46:17  pab
  21.  * sysV fixes
  22.  *
  23.  * Revision 1.4  1992/01/09  22:29:01  pab
  24.  * Fixed for low tag ints
  25.  *
  26.  * Revision 1.3  1992/01/05  22:48:18  pab
  27.  * Minor bug fixes, plus BSD version
  28.  *
  29.  * Revision 1.2  1991/09/11  12:07:34  pab
  30.  * 11/9/91 First Alpha release of modified system
  31.  *
  32.  * Revision 1.1  1991/08/12  16:49:55  pab
  33.  * Initial revision
  34.  *
  35.  * Revision 1.4  1991/03/27  18:25:06  kjp
  36.  * Changes + arg parity correction.
  37.  *
  38.  * Revision 1.3  1991/02/13  18:24:43  kjp
  39.  * Pass.
  40.  *
  41.  */
  42.  
  43. /*
  44.  * Change Log:
  45.  *   Version 1, April 1990
  46.  */
  47.  
  48. #include "defs.h"
  49. #include "structs.h"
  50. #include "funcalls.h"
  51. #include "error.h"
  52.  
  53. #include "global.h"
  54.  
  55. #include "calls.h"
  56. #include "modboot.h"
  57. #include "allocate.h"
  58. #include "modules.h"
  59. #include "threads.h"
  60.  
  61. #ifndef MACHINE_ANY
  62. #define semaphoreof(x) ((SystemSemaphore*) (stringof(x)))
  63. /* Generator... */
  64.  
  65. EUFUN_0( Fn_make_semaphore)
  66. {
  67.   LispObject retval;
  68.  
  69.   retval = allocate_string(stacktop,"",sizeof(SystemSemaphore));
  70.  
  71.   system_initialise_semaphore(semaphoreof(retval));
  72.  
  73.   return(retval);
  74.  
  75. }
  76. EUFUN_CLOSE
  77.  
  78. /* Initialiser... */
  79.  
  80. EUFUN_1( Fn_primitive_initialize_semaphore, sem)
  81. {
  82.  
  83.   if (!is_string(sem))
  84.     CallError(stacktop,
  85.           "initialize-semaphore: non semaphore",sem,NONCONTINUABLE);
  86.  
  87.   /* System specific call... */
  88.  
  89.   system_initialise_semaphore(semaphoreof(sem));
  90.  
  91.   /* Trusting OK... */
  92.  
  93.   return(sem);
  94.  
  95. }
  96. EUFUN_CLOSE
  97.  
  98. /* Opener... */
  99.  
  100. EUFUN_1( Fn_open_semaphore, sem)
  101. {
  102.   if (!is_string(sem))
  103.     CallError(stacktop,"open-semaphore: non semaphore",sem,NONCONTINUABLE);
  104.  
  105.   /* System specific call... */
  106.  
  107.   while (!system_maybe_open_semaphore(stacktop,(semaphoreof(ARG_0(stackbase)))))
  108.     {
  109.       if (thread_signalled(CURRENT_THREAD())
  110.       ||SYSTEM_GLOBAL_VALUE(system_interrupt_flag))
  111.     return nil;
  112.       
  113.       EUCALL_0(Fn_thread_reschedule);
  114.     }
  115.  
  116.   /* Got it... */
  117.  
  118.   return(lisptrue);
  119.  
  120. }
  121. EUFUN_CLOSE
  122.  
  123. /* Closer... */
  124.  
  125. EUFUN_1( Fn_close_semaphore, sem)
  126. {
  127.  
  128.   if (!is_string(sem))
  129.     CallError(stacktop,"close-semaphore: non semaphore",sem,NONCONTINUABLE);
  130.  
  131.   /* Syspec.. */
  132.  
  133.   system_close_semaphore((semaphoreof(sem)));
  134.  
  135.   return(sem);
  136.  
  137. }
  138. EUFUN_CLOSE
  139.  
  140. static SYSTEM_GLOBAL(SystemSemaphore,test_sem);
  141. static SYSTEM_GLOBAL(int,test_sum);
  142. static SYSTEM_GLOBAL(int,test_total);
  143.  
  144. static LispObject runner(LispObject *stacktop)
  145. {
  146.   int n;
  147.  
  148.   for (n=0; n<SYSTEM_GLOBAL_VALUE(test_total); ++n) {
  149.     system_open_semaphore(stacktop,&SYSTEM_GLOBAL_VALUE(test_sem));
  150.     ++SYSTEM_GLOBAL_VALUE(test_sum);
  151.     system_close_semaphore(&SYSTEM_GLOBAL_VALUE(test_sem));
  152.   }
  153.  
  154.   return(nil);
  155. }
  156.  
  157. EUFUN_2( Fn_test_internal_semaphore, threads, count)
  158. {
  159.   LispObject th[100];
  160.   int cthreads,i;
  161.  
  162.   cthreads = intval(threads);
  163.  
  164.   SYSTEM_GLOBAL_VALUE(test_total) = intval(count);
  165.   SYSTEM_GLOBAL_VALUE(test_sum) = 0;
  166.  
  167.   for (i=0; i<cthreads; ++i) {
  168.     LispObject xx;
  169.     xx = (LispObject)
  170.       allocate_module_function(stacktop,
  171.                    (LispObject)NULL,(LispObject)NULL,runner,0);
  172.     EUCALLSET_2(th[i], Fn_make_thread, xx, nil);
  173.     EUCALL_2(Fn_thread_start,th[i],nil);
  174.   }
  175.  
  176.   for (i=0; i<cthreads; ++i) {
  177.     EUCALL_1(Fn_thread_value,th[i]);
  178.   }
  179.  
  180.   return(allocate_integer(stacktop,SYSTEM_GLOBAL_VALUE(test_sum)));
  181. }
  182. EUFUN_CLOSE
  183.  
  184. #endif
  185.   
  186. /* *************************************************************** */
  187. /* Initialisation of this section                                  */
  188. /* *************************************************************** */
  189.  
  190. #ifndef MACHINE_ANY
  191. #define SEMAPHORES_ENTRIES 5
  192. #else
  193. #define SEMAPHORES_ENTRIES 0
  194. #endif
  195.  
  196. MODULE Module_semaphores;
  197. LispObject Module_semaphores_values[1];
  198.  
  199. void initialise_semaphores(LispObject *stacktop)
  200. {
  201.  
  202.   open_module(stacktop,
  203.           &Module_semaphores,
  204.           Module_semaphores_values,"sems",SEMAPHORES_ENTRIES);
  205.  
  206. #ifndef MACHINE_ANY
  207.  
  208.   (void) make_module_function(stacktop,"make-primitive-semaphore",Fn_make_semaphore,0);
  209.   (void) make_module_function(stacktop,"initialize-primitive-semaphore",
  210.                   Fn_primitive_initialize_semaphore,1);
  211.   (void) make_module_function(stacktop,"open-primitive-semaphore",Fn_open_semaphore,1);
  212.   (void) make_module_function(stacktop,"close-primitive-semaphore",Fn_close_semaphore,1);
  213.  
  214.   SYSTEM_INITIALISE_GLOBAL(SystemSemaphore,test_sem,0);
  215.   SYSTEM_INITIALISE_GLOBAL(int,test_sum,0);
  216.   SYSTEM_INITIALISE_GLOBAL(int,test_total,0);
  217.  
  218.   system_allocate_semaphore(&SYSTEM_GLOBAL_VALUE(test_sem));
  219.  
  220.   (void) make_module_function(stacktop,"test-internal-semaphores",
  221.                   Fn_test_internal_semaphore,2);
  222.  
  223. #endif
  224.  
  225.   close_module();
  226.  
  227. }
  228.  
  229.